Fifty: Elektronik/FIFTY Elektronik (PS_Computer_Vertrieb).iso/ps8/fty1017/gepackt.exe/DISK2/PLOTSRC.EXE/LIBMAN.PAS

Pascal/Delphi Source File | 1993-11-10 | 15.8 KB | 632 lines

Unit LibMan;

interface

Uses Dos,StrTool,GEDDEFS,LibAcces;

Const MaxLIBTabSize=1280;

Procedure Init_LIBMan;

Procedure Set_UsedIDset(ID :Byte);
{Markiere ID als benutzt }

Function Is_InUse(ID:Byte):Boolean;
{ Meldet, ob ID in Benutzung }

Procedure ResetUsedFLAG;
{Setze Use_Flags zurück}

Function New_LIBIDNr:Byte;
{ Vergabe einer neuen ID-Nummer }

Function RecentInValidID:Byte;
{Liefert nach Enter_To_LibLst ggf. ungültig gewordene ID zurück }

Function Enter_to_LibList(Var B:Bildelement):Integer;
{ Trägt Element in LIB-Descriptor-Tabelle ein
  Result=-1 :ID schon anderweitig in Benutzung
  Result=-2 :ID-Table voll
  Result= 0 :unzulässiger Datentyp
  Result> 0 :Platz in der ID-Tabelle}

Function IDFromName(N:Str15;Var Result:Integer):Byte;
{ Trägt LIB-Filename N  falls erforderlich mit neuer ID-Nummer }
{ in ID-Table ein }

Procedure Set_LIBID(Var Mac:Bildelement; ID :Byte);
{ Setzt LIB-ID eines Macros auf ID }

Procedure ClearLIBID(Var Mac:Bildelement);
{ Setzt LIB-ID eines Macros auf Null }

Function  Get_LIBID(Var Mac:Bildelement):Word;
{ Bestimmt LIB-ID eines Macros }

Function  LIBtableIDX(IDNr:Word):Word;
{ bestimmt Tabellen-Platz eines Lib-ID-Eintrages }

Function  LibFilename(IDNr:Word):Str15;
{ bestimmt Dateinnamen einer LIB-ID }

Procedure SetOldGeddyVersion(Old:Boolean);
{ Teilt der Unit mit, ob Datei alte GEDDY-Datei ist, Aufruf durch Ausgabe-Treiber}


Function ScanforMac(Var Mac:Bildelement;
                    Var SearchPath,           { Pfad wo Macro zu suchen ist }
                        FileNAME   :PathStr;  { Name der Datei mit BLD-Daten}
                    Var FilDate    :Longint;  { Datei-Datum des Macros      }
                    Var Offset     :Longint;  { Seek-Offset (bei BLD =0     }
                    Var RecCount   :Word):Boolean;{ Anzahl der Records      }
{ sucht nach Macro in Directory und allen LIB-Files dieses Directory }

Procedure UpdateMacroRec(Var Mac:Bildelement;
                         Var SearchPath:PathStr);
{ Sucht nach Macro und setzt ggf. ID-Nr und ID-Table-Eintrag }


Function  LocateMac(Mac:Bildelement;
                    Var SearchPath,           { Pfad wo Macro zu suchen ist }
                        FileNAME   :PathStr;  { Name der Datei mit BLD-Daten}
                    Var FilDate    :Longint;  { Datei-Datum des Macros      }
                    Var Offset     :Longint;  { Seek-Offset (bei BLD =0     }
                    Var RecCount   :Word):    { Anzahl der Records          }
                    Boolean;

{ such Macro in Directory bzw. LIB-File }

Function LIBListSize:Word;
{ liefert Größe der LIB-Liste zurück }

Procedure Get_LibLstRec(Var E:Bildelement;Index:Word);
{ Eintrag(Index) der Lib-Liste zurück }

Procedure Rename_LibLst_Entry(L_name:Str15;Index:Word);
{ benennt Eintrag(Index) der Lib-Liste um}

Function LIBConCat(Lib,Sym:Str15):Str30;
{ Verbindet LIB-Dateinamen mit Symbol-Dateinnamen
  z.B. SCHRAUBEN.LIB , IC14.BLD  ---> SCHRAUBEN.IC14
}

Procedure LIBSplit(Sympfad:Str30;Var LIB,SYM:Str15);
{ spaltet SYMPFPAD auf :
  SCHRAUBEN.IC14 wird zu SCHRAUBEN.LIB und IC14 }


Procedure SetID_toStr(Var S:Str10;ID :Byte);

Function MACListStr(Mac:Bildelement):Str10;
{ Obj.Masterfile+#0+Chr(LibID-Nr) }

Function ID_FromMACListStr(Var S:Str10):Byte;
{ Umkehrfunktion }

Function PartIDEmpty(Var O:Bildelement):Boolean;
{ prüft ob der PartID-String eines Macros leer ist }

Function FullName_O(O:Bildelement):Str30;

Procedure  SaveLIBTable(Var Buffer);
{rettet gesamte LIB-Table und Zustand nach
 Buffer = ARRAY[1..MaxLibTabSize] of Byte und initiaslisiert Zustand}


Procedure  RestoreLIBTable(Var Buffer);
{ speicher gesamte LIB-Table Information aus Buffer zurück
 Buffer = ARRAY[1..MaxLibTabSize] of Byte }


implementation

Const IsOldGEDDYFile:Boolean=false;
      _RecentInvalidID :Byte=0;

      MaxLLIST =64;

Type  LLISTEntry=Record
                   ID  :Byte;
                   Name:String[14];
                  end;
      LIBLST    = Array[1..MaxLList] of LLISTEntry;{1024 - Byte }
      IDset     = Set of 0..255;

      ID_InfoRec=Record   { gesamt 1059 Byte }
                   NList   :Word;
                   Used    :IDSet;
                   OldGEDDY:Boolean;
                   List    :LIBLST;
                  end;
Const
      PLIBLST  : WORD  = 0;
      Used_IDs : IDSet = [];

Var   LibListe : LIBLST;

Procedure Init_LIBMan;
begin
  PLIBLST  := 0;
  Used_IDs := [];
end;

Function New_LIBIDNr:Byte;
{Vergabe einer neuen Nummer }
Var I:Byte;
begin
  New_LIBIDNr:=0;
  For I:=1 to 255 do
    begin
      If Not(I in Used_IDs) then
        begin
          New_LIBIDNr:=I;
          Exit;
        end;
    end;
end;

Procedure Set_UsedIDset(ID:Byte);assembler;
asm
  MOV BL,ID
  OR  BL,BL
  JZ  @@bypass
  XOR BH,BH
  MOV CL,BL
  AND CL,7
  SHR BX,1
  SHR BX,1
  SHR BX,1
  MOV AL,1
  SHL AL,CL
  ADD BX,OFFSET Used_Ids
  OR  [BX],AL
@@bypass:
end;


Function Is_InUse(ID:Byte):Boolean;
begin
  Is_InUse:=ID in Used_IDs;
end;


Procedure ResetUsedFLAG;
begin
  Used_Ids:=[];
end;

Procedure Clear_Lib_Table;
begin
  PLIBLST:=0;
end;

Function RecentInValidID:Byte;
begin
  RecentInvalidID:=_RecentInvalidID;
end;

Function Enter_to_LibList(Var B:Bildelement):Integer;
Var I,J,K:Integer;
begin
  Enter_to_LibList:=0; { falscher Datentyp }
  With ED_InfoTyp(B) do
  begin
    If ElementTyp<>ED_INFO then Exit;
    IF TYP<>Container then Exit;
    _RecentInvalidID:=0;
    LibName:=UpcaseStr(LibName);
    For I:=1 to PLibLst do
     With LIBListe[I] do
      begin
        If Not Is_InUse(ID) then
          begin
            Enter_to_LibList:=I;
            Name:=LibName;
            _RecentInvalidID:=ID; { Diese ID wurde ungültig }
            ID:=LibId; { auf Freiem Platz eingetragen }
            {  Prüfe, ob selbe ID noch einmal vorkommt ? }
            J:=Succ(I);
            While J<=PlibLst do
              begin
                { Wenn Ja , Dann Eintrag aus ID-Table entfernen }
                If LibID=LibListe[J].ID then
                  begin
                    Dec(PLibLst);
                    For K:=J to Pliblst do
                      Libliste[K]:=LibListe[K+1];
                  end;
                Inc(J);
              end;
            Set_UsedIDSet(ID);
            Exit;
          end;
        If (ID=LibID) or (Libname = Name)  then
        begin
          If (Libname = Name) and (ID=LibID) then
            begin
              Enter_to_LibList:=I;
              Exit; { ID schon Eingetragen }
            end;
          Enter_to_libList:=-1; {ID schon für anderen Namen vergeben }
          Exit; { Error }
        end;
      end;


    If PlibLst<MaxLList then
      begin
         Inc(PlibLst);
         Enter_to_LibList:=PlibLst;
         With Libliste[PlibLst] Do
          begin
            Name:=LibName;
            ID:=LibId;
            Set_UsedIDSet(ID);
          end;
      end
     else Enter_to_LibList:=-2; {ID-Liste voll }
  end;
end;

Function IDFromName(N:Str15;Var Result:Integer):Byte;
Var I:Integer;
    IDNr:Byte;
    Info:Ed_InfoTyp;
begin
  IdNr:=0;
  IDFromName:=0;
  Result:=0;
  _RecentInvalidID:=0;
  If N='' then Exit;
  N:=UpcaseStr(N);
  For I:=1 to PLibLst do
    With LibListe[I] Do If Name=N then
       begin IDNr:=ID; Result:=I; end;
  If IDNr=0 then
    begin
      IDNr:=New_LibIDNr;
      Fillchar(Info,Sizeof(Info),0);
      Info.Elementtyp:=Ed_Info;
      Info.Typ:=Container;
      Info.LibName:=N;
      Info.LibID:=IDNr;
      Result:=Enter_to_LibList(Bildelement(Info));
      If Result<1 then IDNr:=0;
    end;
  IDfromName:=IdNr;
end;

Function  Get_LIBID(Var Mac:Bildelement):Word;
Var A,B :Byte;
begin
  With Mac Do
  begin
    A:=Byte(Masterfile[0]);  { High-Nibble}
    B:=Byte(PartID[0]);      { Low -Nibble}
    GET_LIBID:=(A and $F0) or ((B and $F0) shr 4);
  end;
end;

Procedure ClearLIBID(Var Mac:Bildelement);
Var A,B :Byte;
begin
  With Mac Do
  begin
    Byte(Masterfile[0]):=Byte(Masterfile[0]) and $0F;
    Byte(PartID[0]):=Byte(PartID[0]) and $0F;
  end;
end;

Procedure Set_LIBID(Var Mac:Bildelement; ID :Byte);
Var A,B :Byte;
begin
  ClearLIBID(Mac);
  With Mac Do
  begin
    Byte(Masterfile[0]):=Byte(Masterfile[0]) or (ID and $F0);
    Byte(PartID[0]):=Byte(PartID[0]) or (ID shl 4);
  end;
end;

Function  LIBtableIDX(IDNr:Word):Word;
{ Liefert Position  in Dateinamentabelle zu einer ID-Nr }
Var I:Word;
begin
  LibtableIDX:=0;
  For I:=1 to PLIBLST do
    With LIBListe[I] do
      If IDNr=ID then
         begin
           LibTableIDX:=I;
           Exit;
         end;
end;

Function  LibFilename(IDNr:Word):Str15;
{ bestimmt Dateinnamen einer LIB-ID }
Var I:Word;
begin
  LibFileName:='';
  I:=LibtableIdx(IdNr);
  If I>0 then LibFileName:=LIBListe[I].Name;
end;

Procedure SetOldGeddyVersion;
begin
  IsOldGeddyFile:=Old;
end;

Function ScanforMac(Var Mac:Bildelement;
                    Var SearchPath,           { Pfad wo Macro zu suchen ist }
                        FileNAME   :PathStr;  { Name der Datei mit BLD-Daten}
                    Var FilDate    :Longint;  { Datei-Datum des Macros      }
                    Var Offset     :Longint;  { Seek-Offset (bei BLD =0     }
                    Var RecCount   :Word):Boolean;{ Anzahl der Records      }
Var SR    : SearchRec;
    Entry : Dir_Entry;
BEGIN
  Inc(No_blink);
  ScanForMac:=false;
  FilDate:=0;
  Offset:=0;       { In Normalem Macro wird Ab Rec 0 gelesen 0}
  RecCount:=$FFFF; { bis Datei-Ende                           }
  ClearLIBID(Mac);
  Filename:=Mac.Masterfile+Dsuf;
  Processfilename(SearchPath,Filename);
  If FileExists(Filename) then
    begin
      ScanForMac:=true;
      Dec(No_blink);
      Exit;
    end;
  Filename:='*'+LIBsuf;
  Processfilename(SearchPath,Filename);
  FindFirst(Filename,Anyfile,SR);
  While DosError=0 do
    begin
      If (SR.Attr and (Directory or VolumeID or SysFile))=0 then
       begin
         FileName:=SR.Name;
         ProcessFilename(Searchpath,Filename);
         If Find_in_Lib(Filename,Mac.Masterfile,Entry) then
         With Entry do
           begin
             ScanforMac:=True;
             FilDate:=Date;
             Offset:=FileOffset;
             RecCount:=NrOfRecs;
             Dec(No_blink);
             Exit;
           end;
       end; { If }
      FindNext(SR);
    end; { While }
  Dec(No_blink);
end;

Procedure UpdateMacroRec(Var Mac:Bildelement;
                         Var SearchPath:PathStr);
Var FName :PathStr;
    N     :NameStr;
    E     :ExtStr;
    Date,
    Offset:Longint;
    Count :Word;
    R     :Integer;
    ID    :Byte;
begin
  If Get_LIBID(Mac)>0 then Exit;
  If ScanforMac(Mac,Searchpath,Fname,Date,Offset,Count) and (Offset>0) then
   begin
     Fsplit(Fname,Fname,N,E);
     Fname:=N+E;
     ID:=IDFromName(Fname,R);
     If (R>0) and (ID>0) then
       Set_LIBID(Mac,ID);
   end;
end;

Function  LocateMac(Mac:Bildelement;
                    Var SearchPath,           { Pfad wo Macro zu suchen ist }
                        FileNAME   :PathStr;  { Name der Datei mit BLD-Daten}
                    Var FilDate    :Longint;  { Datei-Datum des Macros      }
                    Var Offset     :Longint;  { Seek-Offset (bei BLD =0     }
                    Var RecCount   :Word):    { Anzahl der Records          }
                    Boolean;
Var ID    : Word;
    Entry :Dir_Entry;
BEGIN
  LocateMac:=false;
  Offset:=0;       { In Normalem Macro wird Ab Rec 0 gelesen }
  RecCount:=$FFFF; { bis Datei-Ende                          }
  FilDate:=0;
  If IsOldGEDDYFile then
     { Suchverfahren in alten GEDDY-Dateien }
     LocateMac:=ScanForMac(Mac,Searchpath,Filename,FilDate,Offset,RecCount)
  else
  begin
    ID:=Get_LIBID(Mac);
    ClearLIBID(Mac);
    If ID >0 then
      begin
        Filename:=LibFilename(ID);
        ProcessFilename(Searchpath,Filename);
        If Find_in_Lib(Filename,Mac.Masterfile,Entry) then
            With Entry do
             begin
               Fildate:=Date;
               Offset:=FileOffset;
               RecCount:=NrOfRecs;
               LocateMac:=True;
               Exit;
             end;
      end else
       begin
         Filename:=Mac.Masterfile+Dsuf;
         Processfilename(SearchPath,Filename);
         LocateMac:=FileExists(Filename);
       end;
  end;
END;

Function LIBListSize:Word;
{ liefert Größe der LIB-Liste zurück }
begin
  LibListSize:=PLIBlst;
end;

Procedure Get_LibLstRec(Var E:Bildelement;Index:Word);
{ Eintrag(Index) der Lib-Liste zurück }
begin
  Fillchar(E,Sizeof(E),0);
  With ED_InfoTyp(E),LibListe[Index] do
  begin
    EDVersion:=VersionCode;
    Elementtyp:=ED_Info;
    Typ:=Container;
    LIBID:=Id;
    LIBName:=Name;
  end;
end;

Procedure Rename_LibLst_Entry(L_name:Str15;Index:Word);
{ benennt Eintrag(Index) der Lib-Liste um}
begin
  With LibListe[Index] do
  begin
    Name:=L_Name;
  end;
end;

Function LIBConCat(Lib,Sym:Str15):Str30;
Var P:Byte;
begin
  UpStr(Lib);
  UpStr(Sym);
  P:=Pos('.',SYM);
  If (Sym<>'') and (P>1) then Byte(Sym[0]):=Pred(P);
  P:=Pos('.',Lib);
  If (LIB<>'') and (P>1) then
    begin
      Byte(Lib[0]):=P;
      LibConCat:=Lib+Sym;
    end
  else LibConCat:=Sym;
end;

Procedure LIBSplit(Sympfad:Str30;Var LIB,SYM:Str15);
Var Punkt:Byte;
begin
  LIB[0]:=#0;
  SYM[0]:=#0;
  Punkt:=Pos('.',SymPfad);
  If Punkt>0 then
   begin
     LIB:=Copy(Sympfad,1,Punkt-1);
     LIB:=LIB+Libsuf;
     SYM:=Copy(Sympfad,Punkt+1,Length(Sympfad)-Punkt);
   end
  else
   begin
     LIB:='';
     SYM:=Sympfad;
   end;
end;

Function ID_FromMACListStr(Var S:Str10):Byte;
Var L:Byte;
begin
  ID_FromMACListStr:=0;
  L:=Byte(S[0]);
  If (S[L-1]=#0) and (L>2) then
    ID_FromMACListStr:=Byte(S[L]);
end;

Procedure SetID_toStr(Var S:Str10;ID :Byte);
begin
  If (ID>0) and (S[0]<#9) then
   begin
     Inc(Byte(S[0]));
     S[Byte(S[0])]:=#0;
     Inc(Byte(S[0]));
     S[Byte(S[0])]:=Char(ID);
   end;
end;

Function MACListStr(Mac:Bildelement):Str10;
Var ID:Byte;
    S :Str10;
begin
  MacListStr:='';
  If Mac.ElementTyp<>Macro then exit;
  ID:=Get_LIBID(Mac);
  ClearLIBID(Mac);
  S:=Mac.MasterFile;
  SetID_ToStr(S,ID);
  MaclistStr:=S;
end;

Function PartIDEmpty(Var O:Bildelement):Boolean;
begin
  PartIDEmpty:=(Byte(O.PartID[0]) and $0F)=0;
end;

Function FullName_O(O:Bildelement):Str30;
Var Libname:Str30;
begin
  FullName_O:='';
  If O.ElementTyp<>Macro then Exit;
  LibName:=LibFilename(Get_LibID(O));
  ClearLIBID(O);
  LibName:=LibConCat(Libname,O.Masterfile);
  Fullname_O:=Libname;
end;

Procedure  SaveLIBTable(Var Buffer);
begin
  With ID_InfoRec(Buffer) do
  begin
    NList:=PlibLst;
    Used:=Used_IDs;
    OldGEDDY:=IsOldGEDDYFile;
    List:=LibListe;
  end;
end;

Procedure  RestoreLIBTable(Var Buffer);
begin
  With ID_InfoRec(Buffer) do
  begin
    PlibLst:=Nlist;
    Used_IDs:=Used;
    IsOldGEDDYFile:=OldGeddy;
    LibListe:=List;
  end;
end;


{
   3 verschiedene Aktionen
   A:)  Macro aufrufen bei Bildaufbau
          - ID-Bestimmen, Use_Flag dieser ID setzen
            1.) Macro im RAM : Daten Lesen
            2.) auf Datei
               - LIB-Filename erkennen
               - Daten Lesen und speichern

  B:) ID-Tabelle  Aufbauen beim Datei-Lesen
       Objekt prüfen ob schon vorhanden und eintragen

  C:) ID-Tabelle ergänzen, wenn neues Macro aufgerufen wird
       - neue ID Vergeben
       - Dateinamen und ID in ID-Tabelle eintragen
       - dabei nach ersten freiem (Use_Flag =) Eintrag suchen
       - und Eintragen
  D:) Datei Speichern :
       Suche Nach benutzten ID-Tabelle Einträgen
       und speichere den Eintrag
}

end.